home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Network Supervisor's Toolkit
/
Network Supervisor's Toolkit.iso
/
metering
/
log©
/
setcopy.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-07-10
|
18KB
|
527 lines
(* N *)
(*$include:'SETDIR.INT'*)
(*$include:'SETDOS.INT'*)
(*$include:'SETGRAPH.INT'*)
(**********************************************************************)
(* Setcopy program for use with logcopy. Manages database that log *)
(* copy reads in when invoked. *)
(**********************************************************************)
Program Setcopy(input,output);
uses SETDIR,SETDOS,SETGRAPH;
Const
Program_name = 'SETCOPY version 3.00 by Keith P. Robison';
Copyright = 'copyright Syracuse University 1988';
data_drive = '^';
data_path = 'SYS:PUBLIC';
data_filename = data_drive*':LOG©.DAT';
max_programs = 100;
program_name_length = 80;
server_name_length = 48;
VER = 'VeRsIoN=SETCOPY Version 3.00 by Keith P. Robison'*chr(0)*'$';
Type
pointers_type = Array [1 .. max_programs] of Word;
program_info = Record
Copies : Byte;
logit : Byte;
name : Lstring(program_name_length);
server : Lstring(server_name_length);
End;
programs_type = Array [1 .. max_programs] of program_info;
Var
pointer : pointers_type;
info : programs_type;
count : Integer;
fout : file of byte;
fin : file of byte;
version : Lstring(80);
logging : Boolean;
Value
version := VER;
logging := FALSE;
(**********************************************************************)
(* *)
(* *)
(**********************************************************************)
Procedure cls;
Begin
scroll_screen_up(0,0,0,24,79,31);
gotoxy(0,0);
End; (* cls *)
(**********************************************************************)
(* *)
(* *)
(**********************************************************************)
Procedure key_press;
Begin
gotoxy(24,20);
Write('Press ENTER to continue');
readln;
End; (* key_press *)
(**********************************************************************)
(* *)
(* *)
(**********************************************************************)
Procedure upper_case(Var s : Lstring);
Var
i : Integer;
Begin
if s.len > 0 then for i:= 1 to ord(s.len) Do
if (s[i] >= 'a') and (s[i] <= 'z') Then s[i]:=chr(ord(s[i])-32);
End; (* upper_case *)
(**********************************************************************)
(* *)
(* *)
(**********************************************************************)
Procedure Calc_pointers;
Var
i : Integer;
Begin
pointer[1]:=wrd(count*2+2);
if count > 1 Then
for i:= 2 to count Do
pointer[i]:=pointer[i-1]+3+info[i-1].name.len+1+
info[i-1].server.len;
End; (* Calc_pointers *)
(**********************************************************************)
(* *)
(* *)
(**********************************************************************)
Procedure write_pointers;
Var
i : Integer;
Begin
if count > 0 Then
for i:= 1 to count do
write(fout,lobyte(pointer[i]),hibyte(pointer[i]));
Write(fout,0,0);
End; (* write_pointers *)
(**********************************************************************)
(* *)
(* *)
(**********************************************************************)
Procedure write_info;
Var
i,j : Integer;
Begin
for i:= 1 to count do
Begin
write(fout,info[i].copies,info[i].logit,info[i].name.len);
if info[i].name.len > 0 Then
for j:= 1 to ord(info[i].name.len) Do
Write(fout,wrd(info[i].name[j]));
write(fout,info[i].server.len);
if info[i].server.len > 0 Then
for j:= 1 to ord(info[i].server.len) Do
Write(fout,wrd(info[i].server[j]));
End;
End; (* write_info *)
(**********************************************************************)
(* *)
(* *)
(**********************************************************************)
Procedure read_pointers;
Var
bl,bh : Byte;
Begin
count:=0;
Repeat
count:=count+1;
Read(fin,bl,bh);
pointer[count]:=byword(bh,bl);
Until pointer[count] = 0;
count:=count-1;
End; (* read_pointers *)
(**********************************************************************)
(* *)
(* *)
(**********************************************************************)
Procedure read_info;
Var
i,j : Integer;
b : Byte;
Begin
for i:= 1 to count Do
Begin
read(fin,info[i].copies,info[i].logit,info[i].name.len);
if info[i].name.len > 0 Then
for j:= 1 to ord(info[i].name.len) Do
Begin
read(fin,b);
info[i].name[j]:=chr(b);
End;
read(fin,info[i].server.len);
if info[i].name.len > 0 Then
for j:= 1 to ord(info[i].server.len) Do
Begin
read(fin,b);
info[i].server[j]:=chr(b);
End;
End;
End; (* read_info *)
(**********************************************************************)
(* *)
(* *)
(**********************************************************************)
Procedure read_file;
Var
b : Byte;
Begin
assign(fin,data_filename);
fin.trap:=TRUE;
reset(fin);
if fin.errs = 0 Then
Begin
read(fin,b);
If b = 0 then logging:=TRUE
Else if b = 255 then logging:=FALSE;
read_pointers;
read_info;
close(fin);
End;
End; (* read_file *)
(**********************************************************************)
(* *)
(* *)
(**********************************************************************)
Procedure write_file;
Var
temp : Lstring(64);
rc : Integer;
Begin
assign(fout,data_filename);
fin.trap:=TRUE;
rewrite(fout);
if fout.errs = 0 Then
Begin
if logging then write(fout,0)
Else write(fout,255);
calc_pointers;
write_pointers;
write_info;
close(fout);
copylst(data_filename,temp);
concat(temp,chr(0));
rc:=attrib(ads temp,128);
End
Else writeln('Unable to write file');
End; (* Write_file *)
(**********************************************************************)
(* *)
(* *)
(**********************************************************************)
Procedure initialize;
Var
rc : Integer;
base : Integer;
mask : integer;
Begin
rc:=net_alloc_temp_base(data_drive,0,data_path,base,mask);
count:=0;
End; (* initialize *)
(**********************************************************************)
(* *)
(* *)
(**********************************************************************)
Procedure add_item;
Var
ch : Char;
Begin
cls;
count:=count+1;
Write('Enter program name:');
readln(info[count].name);
upper_case(info[count].name);
Write('Log executions ? (Y/N):');
readln(ch);
if ch in ['Y','y'] Then info[count].logit:=0
Else info[count].logit:=1;
Write('Limited number of copies ? (Y/N) :');
readln(ch);
if ch in ['Y','y'] Then
Begin
Write('How Many Copies:');
readln(info[count].copies);
Write('Enter Server:');
readln(info[count].server);
upper_case(info[count].server);
End
Else
Begin
info[count].copies:=0;
info[count].server.len:=0;
End;
key_press;
End; (* add_item *)
(**********************************************************************)
(* *)
(* *)
(**********************************************************************)
Procedure change_logging;
Begin
cls;
gotoxy(12,10);
if logging then
Begin
logging:=FALSE;
Writeln('Default logging set to OFF');
End
Else
Begin
logging:=TRUE;
Writeln('Default logging set to ON');
End;
key_press;
End; (* change_logging *)
(**********************************************************************)
(* *)
(* *)
(**********************************************************************)
Procedure delete_item;
Var
item : Integer;
i,j : Integer;
Begin
cls;
Writeln;
Write('Enter number of item to delete (0=Quit):');
Readln(item);
if item > 0 then
Begin
if item <> count then
for i:= item+1 to count do info[i-1]:=info[i];
count:=count-1;
End;
key_press;
End; (* delete_item *)
(**********************************************************************)
(* *)
(* *)
(**********************************************************************)
Procedure list_items;
Var
i : Integer;
temp : Lstring(80);
Begin
cls;
Writeln;
writeln('Item ',' ':20,'Program Name',' ':12,'Logging Copies Server');
for i:= 1 to 80 do temp[i]:='=';
temp.len:=80;
Write(temp);
if count = 0 then writeln('File is empty or does not exist')
Else for i:= 1 to count do
Begin
write(i:3,' | ',info[i].name:40,' |');
if info[i].logit = 1 then write(' OFF ')
Else write(' ON ');
If info[i].copies = 0 then write('| ALL ')
Else write('| ',info[i].copies:3,' ');
if info[i].server.len > 0 then write('| ',info[i].server)
Else write('|');
Writeln;
End;
Write(temp);
key_press;
End; (* list_items *)
(**********************************************************************)
(* *)
(* *)
(**********************************************************************)
Procedure modify_item;
Var
ch : Char;
item : Integer;
i,j : Integer;
temp : Lstring(80);
Begin
cls;
Writeln;
Write('Enter number of item to modify (0=Quit):');
Readln(item);
if (item > 0) and (item <= count) then
Begin
write('Item ',' ':20,'Program Name',' ':12);
writeln('Logging Copies Server');
for i:= 1 to 80 do temp[i]:='=';
temp.len:=80;
Write(temp);
write(item:3,' | ',info[item].name:40,' |');
if info[item].logit = 1 then write(' OFF ')
Else write(' ON ');
If info[item].copies = 0 then write('| ALL ')
Else write('| ',info[item].copies:3,' ');
if info[item].server.len > 0 then write('| ',info[item].server)
Else write('|');
Writeln;
Write(temp);
Writeln;
Write('Enter program name [',info[item].name,']:');
readln(temp);
if temp.len > 0 then copylst(temp,info[item].name);
upper_case(info[item].name);
Write('Log executions ? (Y/N) [');
if info[item].logit=0 then write('Y]:')
Else write('N]:');
readln(temp);
if temp.len > 0 then
Begin
ch:=temp[1];
if ch in ['Y','y'] Then info[item].logit:=0
Else info[item].logit:=1;
End;
Write('Limited number of copies ? (Y/N) [');
if info[item].copies > 0 then write('Y]:')
Else write('N]:');
readln(temp);
if temp.len > 0 then ch:=temp[1]
Else
Begin
if info[item].copies > 0 then ch:= 'Y'
Else ch:='N'
End;
if ch in ['Y','y'] Then
Begin
Write('How Many Copies [',info[item].copies:3,']:');
readln(temp);
if temp.len > 0 then
Begin
if NOT decode(temp,info[item].copies) Then
info[item].copies:=0;
End;
if info[item].copies > 0 Then
Begin
Write('Enter Server [',info[item].server,']:');
readln(temp);
if temp.len > 0 then copylst(temp,info[item].server);
while (info[item].server.len > 0 ) and
(info[item].server[1]=' ') do
delete(info[item].server,1,1);
upper_case(info[item].server);
End;
End
Else
Begin
info[item].copies:=0;
info[item].server.len:=0;
End;
End;
key_press;
End; (* Modify_item *)
(**********************************************************************)
(* *)
(* *)
(**********************************************************************)
Procedure exit;
Begin
write_file;
End;
(**********************************************************************)
(* *)
(* *)
(**********************************************************************)
Procedure quit;
Begin
End;
(**********************************************************************)
(* *)
(* *)
(**********************************************************************)
Procedure menu;
Var
s : Lstring(1);
ch : Char;
Begin
Repeat
cls;
Writeln(program_name);
Writeln(copyright);
Writeln;
Writeln;
Write('Default logging is ');
if logging then Writeln('ON') Else Writeln('OFF');
Writeln;
Writeln('A)dd a item');
Writeln('C)hanged default logging');
Writeln('D)elete an item');
Writeln('L)ist items');
Writeln('M)odify an item');
Writeln;
Writeln('Q)uit and Do NOT update file');
Writeln('E)xit and update file');
Writeln;
Write('Enter letter of choice :');
readln(s);
If s.len > 0 then
Begin
ch := s[1];
writeln;
Case ch of
'A','a' : add_item;
'C','c' : change_logging;
'D','d' : delete_item;
'E','e' : exit;
'L','l' : list_items;
'M','m' : modify_item;
'Q','q' : quit;
otherwise;
End;
End;
Until ch in ['q','Q','e','E']
End;
(**********************************************************************)
(* *)
(* *)
(**********************************************************************)
Begin
initialize;
read_file;
menu;
End.
(* O *)